home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 09 - 1993 / 09.09 Sep 93 / Lambda Lambada
Encoding:
Text File  |  1993-06-25  |  6.9 KB  |  267 lines  |  [TEXT/MPS ]
  1. (define my-even?
  2.   (lambda (n)
  3.     (if (zero? n)
  4.         #t
  5.         (my-odd? (1- n)))))
  6. ;
  7. (define my-odd?
  8.   (lambda (n)
  9.     (if (zero? n)
  10.         #f
  11.         (my-even? (1- n)))))
  12. ;
  13. (my-even? 5)
  14. ;
  15. ; Get out of global environment--use local environment.
  16. ;
  17. (define mutual-even?
  18.   (letrec 
  19.     ((my-even? (lambda (n)
  20.                  (if (zero? n)
  21.                      #t
  22.                      (my-odd? (1- n)))))
  23.      (my-odd? (lambda (n)
  24.                 (if (zero? n)
  25.                     #f
  26.                     (my-even? (1- n))))))
  27.     my-even?))
  28. ;
  29. (mutual-even? 5)
  30. ;
  31. ; Get rid of destructive letrec.  Use let instead.
  32. ; Make a list of the mutually recursive functions.
  33. ;
  34. (define mutual-even?
  35.   (lambda (n)
  36.     (let 
  37.       ((function-list 
  38.         (cons (lambda (functions n) ; even?
  39.                 (if (zero? n)
  40.                     #t
  41.                     ((cdr functions) functions 
  42.                                      (1- n))))
  43.               (lambda (functions n) ; odd?
  44.                 (if (zero? n)
  45.                     #f
  46.                     ((car functions) functions 
  47.                                      (1- n)))))))
  48.       ((car function-list) function-list n))))
  49. ;
  50. (mutual-even? 5)
  51. ;
  52. ; Curry, and get rid of initial (lambda (n) ...) .
  53. ;
  54. (define mutual-even?
  55.   (let 
  56.     ((function-list 
  57.       (cons (lambda (functions) ; even?
  58.               (lambda (n) 
  59.                 (if (zero? n)
  60.                     #t
  61.                     (((cdr functions) functions) 
  62.                      (1- n)))))
  63.             (lambda (functions) ; odd?
  64.               (lambda (n) 
  65.                 (if (zero? n)
  66.                     #f
  67.                     (((car functions) functions) 
  68.                      (1- n))))))))
  69.     ((car function-list) function-list)))
  70. ;
  71. (mutual-even? 5)
  72. ;
  73. ; Abstract ((cdr functions) functions) out of if, etc..
  74. ;
  75. (define mutual-even?
  76.   (let 
  77.     ((function-list 
  78.       (cons (lambda (functions) 
  79.               (lambda (n) 
  80.                 ((lambda (f)
  81.                    (if (zero? n)
  82.                        #t
  83.                        (f (1- n))))
  84.                  ((cdr functions) functions))))
  85.             (lambda (functions) 
  86.               (lambda (n) 
  87.                 ((lambda (f)
  88.                    (if (zero? n)
  89.                        #f
  90.                        (f (1- n))))
  91.                  ((car functions) functions)))))))
  92.     ((car function-list) function-list)))
  93. ;
  94. (mutual-even? 5)
  95. ;
  96. ; Massage functions into abstracted versions of 
  97. ; originals.
  98. ;
  99. (define mutual-even?
  100.   (let 
  101.     ((function-list 
  102.       (cons (lambda (functions) 
  103.               (lambda (n) 
  104.                 (((lambda (f)
  105.                     (lambda (n)
  106.                       (if (zero? n)
  107.                           #t
  108.                           (f (1- n)))))
  109.                   ((cdr functions) functions))
  110.                  n)))
  111.             (lambda (functions) 
  112.               (lambda (n) 
  113.                 (((lambda (f)
  114.                     (lambda (n)
  115.                       (if (zero? n)
  116.                           #f
  117.                           (f (1- n)))))
  118.                   ((car functions) functions))
  119.                  n))))))
  120.     ((car function-list) function-list)))
  121. ;
  122. (mutual-even? 5)
  123. ;
  124. ; Separate abstracted functions out from recursive 
  125. ; mechanism.
  126. ;
  127. (define mutual-even?
  128.   (let 
  129.     ((abstracted-functions
  130.       (cons (lambda (f)
  131.               (lambda (n)
  132.                 (if (zero? n)
  133.                     #t
  134.                     (f (1- n)))))
  135.             (lambda (f)
  136.               (lambda (n)
  137.                 (if (zero? n)
  138.                     #f
  139.                     (f (1- n))))))))
  140.     (let 
  141.       ((function-list 
  142.         (cons (lambda (functions) 
  143.                 (lambda (n) 
  144.                   (((car abstracted-functions)
  145.                     ((cdr functions) functions))
  146.                    n)))
  147.               (lambda (functions) 
  148.                 (lambda (n) 
  149.                   (((cdr abstracted-functions)
  150.                     ((car functions) functions))
  151.                    n))))))
  152.       ((car function-list) function-list))))
  153. ;
  154. (mutual-even? 5)
  155. ;
  156. ; Abstract out variable abstracted-functions in 2nd let.
  157. ;
  158. (define mutual-even?
  159.   (let 
  160.     ((abstracted-functions
  161.       (cons (lambda (f)
  162.               (lambda (n)
  163.                 (if (zero? n)
  164.                     #t
  165.                     (f (1- n)))))
  166.             (lambda (f)
  167.               (lambda (n)
  168.                 (if (zero? n)
  169.                     #f
  170.                     (f (1- n))))))))
  171.     ((lambda (abstracted-functions)
  172.        (let 
  173.          ((function-list 
  174.            (cons (lambda (functions) 
  175.                    (lambda (n) 
  176.                      (((car abstracted-functions)
  177.                        ((cdr functions) functions))
  178.                       n)))
  179.                  (lambda (functions) 
  180.                    (lambda (n) 
  181.                      (((cdr abstracted-functions)
  182.                        ((car functions) functions))
  183.                       n))))))
  184.          ((car function-list) function-list)))
  185.      abstracted-functions)))
  186. ;
  187. (mutual-even? 5)
  188. ;
  189. ; Separate recursion mechanism into separate function.
  190. ;
  191. (define y2
  192.   (lambda (abstracted-functions)
  193.     (let 
  194.       ((function-list 
  195.         (cons (lambda (functions) 
  196.                 (lambda (n) 
  197.                   (((car abstracted-functions)
  198.                     ((cdr functions) functions))
  199.                    n)))
  200.               (lambda (functions)
  201.                 (lambda (n) 
  202.                   (((cdr abstracted-functions)
  203.                     ((car functions) functions))
  204.                    n))))))
  205.       ((car function-list) function-list))))
  206. ;
  207. (define mutual-even? 
  208.   (y2
  209.    (cons (lambda (f)
  210.            (lambda (n)
  211.              (if (zero? n)
  212.                  #t
  213.                  (f (1- n)))))
  214.          (lambda (f)
  215.            (lambda (n)
  216.              (if (zero? n)
  217.                  #f
  218.                  (f (1- n))))))))
  219. ;
  220. (mutual-even? 5)
  221. ;
  222. ; y2 has selector built into it--generalize it!
  223. ;
  224. (define y2-choose
  225.   (lambda (abstracted-functions)
  226.     (lambda (selector)
  227.       (let 
  228.         ((function-list 
  229.           (cons (lambda (functions) 
  230.                   (lambda (n) 
  231.                     (((car abstracted-functions)
  232.                       ((cdr functions) functions))
  233.                      n)))
  234.                 (lambda (functions)
  235.                   (lambda (n) 
  236.                     (((cdr abstracted-functions)
  237.                       ((car functions) functions))
  238.                      n))))))
  239.         ((selector function-list) function-list)))))
  240. ;
  241. ; Now we can achieve the desired result--defining 
  242. ; both mutual-even? and mutual-odd? without recursion.
  243. ;
  244. (define mutual-even-odd?
  245.   (y2-choose
  246.    (cons (lambda (f)
  247.            (lambda (n)
  248.              (if (zero? n)
  249.                  #t
  250.                  (f (1- n)))))
  251.          (lambda (f)
  252.            (lambda (n)
  253.              (if (zero? n)
  254.                  #f
  255.                  (f (1- n))))))))
  256. ;
  257. (define mutual-even? 
  258.   (mutual-even-odd? car))
  259. ;
  260. (define mutual-odd?
  261.   (mutual-even-odd? cdr))  
  262. ;
  263. (mutual-even? 5)
  264. (mutual-odd? 5)
  265. (mutual-even? 4)
  266. (mutual-odd? 4)
  267.